home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
BBS-Archive
/
Dev
/
Obrn-A_1.6_lib.lha
/
oberon-a
/
source3.lha
/
source
/
AmigaUtil
/
WbConsole.mod
< prev
Wrap
Text File
|
1995-06-29
|
3KB
|
96 lines
(*************************************************************************
$RCSfile: WbConsole.mod $
Description: Module to open a console window for programs run from the
Workbench. Ensures that the program has a standard IO
environment, with valid Input() and Output() filehandles.
Created by: fjc (Frank Copeland)
$Revision: 3.8 $
$Author: fjc $
$Date: 1995/06/04 23:18:08 $
Copyright © 1994, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
*************************************************************************)
<* STANDARD- *>
MODULE WbConsole;
IMPORT
SYS := SYSTEM, Kernel, e := Exec, d := Dos, wb := Workbench, i := Icon;
CONST
DefWbConsole = "CON:40/12/480/150/Oberon-A Console Window";
maxD = 9;
VAR
wbConsole : d.FileHandlePtr;
(*------------------------------------*)
PROCEDURE* CloseWbConsole (VAR rc : LONGINT);
BEGIN (* CloseWbConsole *)
IF wbConsole # NIL THEN d.OldClose (wbConsole) END
END CloseWbConsole;
(*------------------------------------*)
PROCEDURE SetupWbConsole ();
VAR
oldDir : d.FileLockPtr;
oldFH : d.FileHandlePtr;
console : e.LSTRPTR;
diskObj : wb.DiskObjectPtr;
toolTypes : wb.ToolTypePtr;
process : d.ProcessPtr;
conTask : e.MsgPortPtr;
wbMsg : wb.WBStartupPtr;
BEGIN (* SetupWbConsole *)
IF i.base # NIL THEN (* Check for a WINDOW= tooltype *)
wbMsg := Kernel.WBenchMsg;
(* First CD to the app's directory *)
oldDir := d.CurrentDir (wbMsg.argList [0].lock);
(* Attempt to load the app's icon *)
diskObj := i.GetDiskObject (wbMsg.argList [0].name^);
IF diskObj # NIL THEN
console := i.FindToolType (diskObj.toolTypes, "WINDOW");
(* We will free diskObj AFTER we have finished with console. *)
END;
(* Back to where we started *)
oldDir := d.CurrentDir (oldDir);
ELSE
diskObj := NIL; console := NIL
END;
(* Open the console window *)
IF console = NIL THEN console := SYS.ADR (DefWbConsole) END;
wbConsole := d.Open (console^, d.newFile);
IF diskObj # NIL THEN i.FreeDiskObject (diskObj) END;
ASSERT (wbConsole # NIL, 98);
(* Set the console task and the Input/Output handles. *)
oldFH := d.SelectInput (wbConsole);
IF oldFH # NIL THEN d.OldClose (oldFH) END;
oldFH := d.SelectOutput (wbConsole);
IF oldFH # NIL THEN d.OldClose (oldFH) END;
conTask := wbConsole.type;
IF conTask # NIL THEN
conTask := d.SetConsoleTask (conTask)
(* I assume the old one can be ignored. The autodocs are silent
** about this.
*)
END;
Kernel.SetCleanup (CloseWbConsole);
END SetupWbConsole;
BEGIN (* WbConsole *)
wbConsole := NIL;
IF Kernel.fromWorkbench THEN SetupWbConsole () END
END WbConsole.